00010	BEGIN "FIX"
00020	DEFINE ⊂="COMMENT"; ⊂ NOV.26,1973;
00030	⊂ The initial program to prepare files of input parameters obtained
00040	  pulse synchronously from the acoustic files and to convert header
00050	  information into this same form;
00060	DEFINE ⊃="⊂";
00070	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00080	REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00090	LABEL STARTP,STOPP,TOFORM;
00100	 DEFINE \=" "; ⊂ DEFINE \="SAFE"; ⊂ Alternarte definitions;
00110	⊂ REQUIRE "LPC2[X,ALS]" LOAD_MODULE;
00120	 require "INDATE[X,ALS]" LOAD_MODULE;
00130	FORTRAN REAL PROCEDURE SQRT(REAL X);
00140	FORTRAN REAL PROCEDURE ALOG10(REAL X);
00150	FORTRAN REAL PROCEDURE COS(REAL X);
00160	FORTRAN REAL PROCEDURE SIN(REAL X);
00170	INTEGER ZEROC,ZEROF,DX;
00180	⊂ EXTERNAL FORTRAN PROCEDURE LPC1(REFERENCE REAL A,B,R0,C;⊂ REFERENCE INTEGER N,I,J);
00190	REQUIRE "F[X,ALS]" LOAD_MODULE;
00200	EXTERNAL FORTRAN PROCEDURE FRXFM
00210	         (REFERENCE INTEGER M;REFERENCE REAL X,Y);
00220	 EXTERNAL PROCEDURE PREPARE;
00230	EXTERNAL PROCEDURE DEFINES;
00240	EXTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00250	EXTERNAL PROCEDURE DATOUT;
00260	EXTERNAL INTEGER INFLAG,NX;
00270	\ INTERNAL REAL ARRAY A,B,C,D[0:512];
00280	REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00290	INTERNAL REAL R0;
00300	INTEGER LPCOPT;
00310	\ INTEGER ARRAY DPYBUF[0:1535];
00320	\ INTEGER ARRAY LFILE[0:'177];
00330	\ INTEGER ARRAY SYMBOL[0:127];
00340	\ INTEGER ARRAY DAT,AVDAT[0:23];
00350	\ INTERNAL INTEGER ARRAY FVAL[0:8];
00360	\ EXTERNAL INTEGER ARRAY NEW[0:512];
00370	\ INTEGER ARRAY PFFT[0:64]; INTEGER SIZE;
00375	INTEGER ARRAY FFTB[0:511]; INTEGER FFTX;
00380	INTEGER FX;
00390	STRING ARRAY SAMPLE[0:127];
00400	INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,
00410	        POINTF,POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00420	INTERNAL INTEGER M,N;
00430	INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,
00440	        PTCNT,PICK,JP,JPX,OPT,OPT1,SHUFCT;
00450	INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LFX,
00460	        SEGTOT,SEGIN,KKT,NNT,ITT,JTT,KTT;
00470	BOOLEAN ER;
00480	INTEGER CHAN2,CHAN3,CHAN4,CHAN6,CHANX;
00490	INTERNAL INTEGER CHAN5;
00500	\ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00510	STRING FILEN,FILEF,READ,READ1,READT,
00515	   READTT,FILEO,READ2,FILEQ,TFILE,FILLST,FILEP;
00520	
00530	PROCEDURE OUTALL(STRING S);
00540	BEGIN
00550	STRING SS; INTEGER J;
00560	SETBREAK(18,0,NULL,"OSN");
00570	SS←SCAN(S,18,J);
00580	OUTSTR(SS);
00590	END;
00600	
00610	PROCEDURE DATAIN;
00620	BEGIN
00630	INTEGER J;
00640	  FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00650	⊂ IF EOF=0 THEN OUTSTR("BUF") ELSE OUTSTR(" EOF ");
00660	  IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512);
00670	⊂ IF EOF=0 THEN OUTSTR(" New BUF ") ELSE OUTSTR(" EOF ");
00680	  POINTX←POINT(12,BUF[0],-1);
00690	SEGC←II←II+12; JJ←II+11;
00700	END;
00710	
00720	
00730	PROCEDURE DTTTIN;
00740	BEGIN
00750	INTEGER J;
00760	  IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00770	  ELSE OUTSTR
00780	       ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00790	  FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00800	  ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00810	⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00820	END;
00830	
00840	
00850	PROCEDURE RARDIS;
00860	BEGIN
00870	INTEGER I,J,K,SP;
00880	INTEGER LY,DY;
00890	REAL MAX,MIN;
00900	
00910	
00920	MAX←-1000.;MIN←10000.;
00930	FOR I←0 STEP 1 UNTIL 256 DO  IF C[I]>MAX THEN MAX←C[I];
00940	SP←6;  COMMENT HORIZONTAL SPACING;
00950	FOR I←0 STEP 1 UNTIL 256 DO BEGIN 
00960	  C[I]←5.5*(C[I]+48-MAX); IF C[I]<0 THEN C[I]←0; END;
00970	
00980	
00990	RIVECT(35,130);
01000	
01010	SETFORMAT(1,0);
01020	⊂ Write horizantal numbers;
01030	FOR I←0 STEP 1 UNTIL 5 DO BEGIN
01040	  DPYSST(CVS(I)); RIVECT(139,0); END; RIVECT(-139,0);
01050	FOR I←6 STEP 1 UNTIL 10 DO BEGIN
01060	  RIVECT(36,0); DPYSST(CVS(I)); END; RIVECT(-22,-5);
01070	 RIVECT(-512,0); RIVECT(-512,0);
01080	
01090	rivect(-1,0); ⊂ Start with 1 off so total will be correct;
01100	⊂ Draw scale to 5000, with 50 markers to 770;
01110	FOR I←1 STEP 1 UNTIL 5 DO BEGIN
01120	  FOR J←1 STEP 1 UNTIL 2 DO BEGIN
01130	    FOR K←1 STEP 1 UNTIL 2 DO BEGIN
01140	      RIVECT(15,0); RIVECT(0,-10); RVECT(0,10);
01150	      RIVECT(16,0); RIVECT(0,-10); RVECT(0,10); END;
01160	    RIVECT(15,0); RIVECT(0,-50); RVECT(0,50); END;
01170	  RIVECT(0,-264); RVECT(0,264); END;
01180	
01190	⊂ Draw scale from 5000 to 10,000, with 25 markers to 255;
01200	FOR I←1 STEP 1 UNTIL 5 DO BEGIN
01210	  FOR J←1 STEP 1 UNTIL 4 DO BEGIN
01220	    RIVECT(10,0); RIVECT(0,-10); RVECT(0,10); END;
01230	  RIVECT(11,0); RIVECT(0,-264); RVECT(0,264); END;
01240	RVECT(-512,0); RVECT(-512,0);
01250	
01260	SETFORMAT(2,0);
01270	⊂ Vertical numbers and vertical scale;
01280	FOR I←0 STEP 12 UNTIL 42 DO BEGIN
01290	  RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(15,7);
01300	  RVECT(-10,0); RIVECT(0,-33);
01310	  RIVECT(-35,-7); DPYSST(CVS(I+6)); RIVECT(10,7);
01320	  RVECT(-5,0);RIVECT(0,-33); END;
01330	RIVECT(0,264); RVECT(0,-264);
01340	RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(5,7);
01350	  RVECT(512,0); RVECT(512,0); RIVECT(-512,0); RIVECT(-512,0);
01360	
01370	LY←C[0]; RIVECT(0,LY);
01380	FOR I←1 STEP 1 UNTIL 128 DO
01390	BEGIN
01400		DY←C[I]-LY;
01410		LY←LY+DY;
01420		RVECT(SP,DY);
01430	END;
01440	SP←2;
01450	FOR I←129 STEP 1 UNTIL 256 DO
01460	BEGIN
01470		DY←C[I]-LY;
01480		LY←LY+DY;
01490		RVECT(SP,DY);
01500	END;
01510	RIVECT(0,108-LY);
01520	DPYOUT(0); PTOCHW(0,'10120);
01530	END "RARDIS";
01540	
01550	
01560	INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
01570	BEGIN "FORM"
01580	REAL ERRN,ERR;
01590	INTEGER I,J;
01600	 M←9; N←2↑M; DEFINE PI="3.141592653";
01610	IF FX=0 THEN
01620	  FOR I←0 STEP 1 UNTIL N DO  WINDOW[I]←(1-COS((2*PI*I)/N))/2
01630	
01640	  ELSE BEGIN N←FVAL[FX+1]-FVAL[FX]; J←0;
01650	    FOR I←0 STEP 1 UNTIL FVAL[FX] DO WINDOW[I]←0;
01660	    FOR I←FVAL[FX] STEP 1 UNTIL FVAL[FX+1] DO BEGIN
01670	      WINDOW[I]←(1-COS((2*PI*J)/N))/2; J←J+1; END;
01680	    FOR I←FVAL[FX+1] STEP 1 UNTIL 512 DO WINDOW[I]←0; END;
01690	  FOR I←0 STEP 1 UNTIL 512 DO A[I]←D[I];
01700	
01710	IF LPCOPT=0 THEN BEGIN "LPC"
01720	  FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
01730	 ⊂  LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
01740	I←24; J←N%2;
01750	⊂  LPC1(A[0],B[0],R0,C[0],N,I,J);
01760	END "LPC" ELSE
01770	
01780	BEGIN "FFT"
01790	FOR I←0 STEP 1 UNTIL 512 DO BEGIN
01800	  A[I]←D[I]*WINDOW[I]; B[I]←0;
01810	⊃ SETFORMAT(10,3); ⊃  OUTSTR(CVS(I)&TB&CVG(D[I])&TB&CVG(A[I])&CRLF);
01820	END;
01830	FRXFM(M,A[0],B[0]);
01840	⊃ OUTSTR("FFT COMPLETE"&CRLF);
01850	J←0;
01860	FOR I←0 STEP 1 UNTIL 256 DO BEGIN
01870	  X←A[I]↑2+B[I]↑2+1.*10↑-37;
01880	IF X>J THEN J←X;
01890	⊃ OUTSTR(CVG(A[I])&"  "&CVG(B[I])&"  "&CVG(X)&TB);
01900	  C[I]←10.*ALOG10(X); END;
01910	⊂ IF J%N>SIZE THEN BEGIN SIZE←J%N;
01920	⊂   OUTSTR("SIZE="&CVS(SIZE%256)&CRLF); ⊂ END;
01930	END "FFT";	
01940	
01950	END "FORM";
01960	
01970	PROCEDURE MARK;
01980	BEGIN "MARK"
01990	INTEGER I,JJ,K,L,JJP,LP,PT2;
02000	
02010	RIVECT(0,-130); SETFORMAT(3,0);
02020	FOR I←0 STEP 20 UNTIL 340 DO BEGIN
02030	  DPYSST(CVS(I)); RIVECT(15,0); END;
02040	RIVECT(-555,30); RIVECT(-500,0);
02050	
02060	FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
02070	  RIVECT(0,30); RVECT(0,-30);
02080	  FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
02090	    FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
02100	      RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
02110	      RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
02120	      END "TEN";
02130	    RVECT(0,20); RIVECT(0,-20);
02140	    IF I≥300 THEN DONE "HUNDRED";
02150	    END "FIFTY";
02160	  END "HUNDRED";
02170	RIVECT(-550,100); RIVECT(-500,0);
02180	
02190	K←D[0]%8; RIVECT(0,K);
02200	FOR I←1 STEP 1 UNTIL 350 DO BEGIN
02210	  JJP←D[I]%8;
02220	  LP←JJP-K; RVECT(3,LP); K←JJP; END;
02230	RIVECT(-550,-K); RIVECT(-500,0);
02240	
02250	    RIVECT(500,0);
02260	      FOR JJ←1 STEP 1 UNTIL 2 DO BEGIN
02270	        L←3*FVAL[JJ]-500;
02280	        RIVECT(L,100); RVECT(0,-100); RIVECT(-25,0); RVECT(50,0);
02290	        RIVECT(-25,0); RVECT(0,-100); RIVECT(-L,100); END;
02300	      RIVECT(-500,0);
02310	      DPYOUT(0); PTOCHW(0,'10120);
02320	
02330	END "MARK";
02340	
02350	INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
02360	⊃ Outputs display buffer BUFR to disk file FILE in a format
02370	readable by the Nealy Calcomp plotter program PLTVEC, and by
02380	the Quam Video Synthesizer program MIRTOP;
02390	IF FILE THEN
02400	BEGIN	INTEGER DSIZ,CCCHN;
02410		OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
02420		ENTER(CCCHN,FILEN&".GRF",0);
02430		DPYPARS;DSIZ←BUFR[1]+4;
02440		ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
02450		ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
02460		RELEASE(CCCHN);
02470	END "CALCOMP";
02480	
02490	
02500	PROCEDURE FFTOUT;
02510	BEGIN
02520	INTEGER I,J;
02530	
02540	IF FFTX≥512 THEN BEGIN
02550	  ARRYOUT(CHAN6,FFTB[0],512);
02560	  FFTX←0; FOR I←0 STEP 1 UNTIL 511 DO FFTB[I]←0;
02570	  END;
02580	
02590	FFTB[FFTX]←(FVAL[4] LAND '777777700000)+(FVAL[2]-FVAL[1]);
02600	POINTF←POINT(9,FFTB[FFTX+1],-1);
02610	FOR I←0 STEP 1 UNTIL 251 DO BEGIN
02620	  J←C[I]*4;
02625	  IF J<0 THEN J←0; IF J>511 THEN J←511;
02630	  IDPB(J,POINTF);
02640	  END;
02650	FFTX←FFTX+64;
02660	
02670	END;
     

00010	FILEN←"HI20.001[CMP,VIN]";
00020	FILEO←"SEG1.FRI";
00030	INFLAG←0; PREPARE; INFLAG←1; DEFINES; ⊂ Get names and limits;
00040	STDBRK(1);
00050	 SETBREAK(14,"∃",NULL,"INS");
00060	 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00070	 SETBREAK(16,'56,NULL,"INA");
00080	 SETBREAK(17,'12,'15,"INS");
00090	
00100	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00110	OUTSTR("This program generates files in the new format containing header"&
00120	  " information"&CRLF&
00130	  "  and pulse synchronous parameters for each pulse period, packed 4 to"&
00140	  " word."&CRLF&LF);
00160	OUTSTR("At present this program takes acoustic data from [CMP,VIN],"&
00170	   CRLF&tb&"indentifying information from MAP.PHM[11,ALS]"&CRLF&
00180	   TB&"pulse informstion from .P[PIT,NJM] files"&CRLF&TB&
00190	   "and header information from files .T0X[11,ALS]."&CRLF&LF);
00200	outstr("It creates files .SYN[SYN,ALS]."&CRLF);
00210	
00220	CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00230	LOOKUP(CHAN4,"MAP.PHN[11,ALS]",ER);
00240	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[11,ALS].  File = ");
00250	LOOKUP(CHAN4,TFILE←INCHWL,ER); END;  EOFA←0;
00260	FILLST←INPUT(CHAN4,14);
00270	CLOSE(CHAN4);
00280	
00290	FOR I←0 STEP 1 UNTIL 127 DO  BEGIN
00300	  WHILE TRUE DO BEGIN
00310	    READ1←SCAN(FILLST,17,K);
00320	    READ3←READ1[1 TO 1];
00330	    IF READ3≠"⊂"  THEN DONE; END;
00340	IF READ3="" THEN DONE;
00350	  SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00360	  SAMPLE[I]←READ1; END;
00370	
00380	STARTP:
00390	
00400	OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00410	IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00420	
00430	⊂ Begin FILEREAD;
00440	FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00450	  CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00460	SETFORMAT(-3,0); FILEQ←CVS(PP);
00470	  FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,VIN]";
00480	LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00490	WHILE ER DO BEGIN
00500	   IF PP>1 THEN BEGIN OUTSTR("Out of data, will terminate."&CRLF);
00510	     GOTO STOPP; END;
00520	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00530	   LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00540	J←K←L←STATE←VAL←0; R←-1;
00550	SETFORMAT(1,0);  FILEQ←CVS(PP); JP←FVAL[0]←1000; R←-1; CLRBUF;
00560	II←-11; JJ←-1;
00570	
00580	DATAIN;
00590	FOR J←0 STEP 1 UNTIL 511 DO BEGIN
00600	  VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096; D[J]←VAL; END;
00610	SEGIN←4; FVAL[1]←FVAL[2]←0;
00620	
00630	READT←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00640	CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00650	LOOKUP(CHAN2,READT,ER); TFILE←READT;
00660	WHILE ER DO BEGIN
00670	   IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00680	     GOTO STARTP; END;
00690	   OUTSTR(CRLF&"Can not find file "&TFILE&"  File= ");
00700	   LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00710	ARRYIN(CHAN2,LFILE[0],'200);	⊂ Input header;
00720	LFX←21; CLOSE(CHAN2);
00730	
00740	JPX←KK←-1;
00750	
00760	SEGTOT←(LFILE[0]*6)%256; CLOSE(CHAN2);
00770	⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&"   ");
00780	
00790	FILEP←FILEO[1 TO 3]&FILEQ&".SYN[SYN,ALS]";
00800	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'14,0,2,0,0,0);
00810	ENTER(CHAN5,FILEP,0);
00820	OUTSTR("File "&FILEP&" has been opened");
00830	 ARRYOUT(CHAN5,LFILE[0],'200); ⊂ Write header;
00840	OUTSTR(" and header information written."&CRLF);
00850	
00851	FILEF←FILEO[1 TO 3]&FILEQ&".FFT[SYN,ALS]";
00852	CLOSE(CHAN6); OPEN(CHAN6,"DSK",'14,0,2,0,0,0);
00853	ENTER(CHAN6,FILEF,0);
00854	OUTSTR("File "&FILEF&" has been opened");
00855	 ARRYOUT(CHAN6,LFILE[0],'200); ⊂ Write header;
00856	OUTSTR(" and header information written."&CRLF);
00857	FFTX←0;
00858	
00860	READ2←READT;
00870	READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
00880	⊂ OUTSTR(READTT&CRLF);
00890	CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
00900	LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
00910	IF ER THEN BEGIN
00920	  OUTSTR("No .P data (S to start over, space bar to ignore) ");
00930	  IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
00940	    BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
00950	    CLRBUF; END; END;
00960	
00970	FOR I←1 STEP 1 UNTIL 8 DO FVAL[I]←0; FVAL[0]←10000;
00980	DTTTIN;
00990	FVAL[6]←BUFTT[0]; FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;KTT←0;
01000	
01010	
01020	
01030	
01040	⊂ Begin "GET";
01050	
01060	WHILE TRUE DO BEGIN "GET"
01070	
01080	FX←1;
01090	
01100	⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
01110	IF JJ<SEGIN THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01120	
01130	⊂ OUTSTR("JJ="&CVS(JTT)&TB&"J="&CVS(J)&"before DTTTIN");
01140	IF JTT<(SEGIN-1)*128 THEN DTTTIN; 
01150	⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
01160	
01170	⊂  FVAL ASSIGNMENTS
01180		[1]	DELTA FOR FIRST MARKER
01190		[2]	DELTA FOR SECOND MARKER
01200		[3]	DELTA FOR THIRD MARKER
01210		[4]	PULSE DATE FOR FIRST MARKER
01220		[5]	PULSE DATA FOR SECOND MARKER
01230		[6]	PULSE DATA FOR THIRD MARKER;
01240	
01250	
01260	FVAL[1]←FVAL[2]; FVAL[4]←FVAL[5];
01270	
01280	⊂  OUTSTR(CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&
01290	  TB&CVS(FVAL[4] LSH -15)&
01300	  " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&CRLF);
01310	  WHILE FVAL[1]>127 DO BEGIN
01320	    IF SEGIN≥JJ THEN IF EOF≠0 THEN DONE "GET" ELSE DATAIN;
01330	    FOR Q←0 STEP 1 UNTIL 383 DO D[Q]←D[Q+128];
01340	    FOR Q←384 STEP 1 UNTIL 511 DO BEGIN
01350	      VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
01360	      D[Q]←VAL; END; SEGIN←SEGIN+1;
01370	    FVAL[1]←FVAL[1]-128; FVAL[3]←FVAL[3]-128; END;
01380	
01390	IF (FVAL[3]-FVAL[1])>256 THEN BEGIN
01400	  FVAL[2]←FVAL[1]+256;
01410	  FVAL[5]←(FVAL[4] LAND '377777700000)+'40000000; END
01420	ELSE BEGIN FVAL[2]←FVAL[3];  FVAL[5]←FVAL[6]; 
01430	     KTT←KTT+1; IF KTT≥512 THEN DTTTIN;
01440	    FVAL[6]←BUFTT[KTT];
01450	    FVAL[3]←(FVAL[6] LSH -15)-(SEGIN-4)*128;END;
01460	
01470	⊂  OUTSTR(CRLF&CVS(SEGIN)&TB&CVS(FVAL[1])&TB&CVS(FVAL[2])&TB&CVS(FVAL[3])&TB&
01480	  CVS(FVAL[4] LSH -15)&
01490	  " "&CVS(FVAL[5] LSH -15)&" "&CVS(FVAL[6] LSH -15)&TB&TB);
01500	
01510	
01520	WHILE JPX+KK<(FVAL[4] LSH -15) DO BEGIN
01530	    IF (LFILE[LFX]=0) THEN DONE; IF LFX>'177 THEN DONE;
01540	    JPX←(LDB(POINT(14,LFILE[LFX],27))-1)*128;
01550	     KK←(LDB(POINT(8,LFILE[LFX],35))-1)*128;
01560	    L←LFILE[LFX] LAND '777760000000;
01570	    LFX←LFX+1; END;
01580	    IF JPX<(FVAL[5] LSH -15) THEN OUTSTR(CVSTR(L)) ELSE OUTSTR(" ");
01590	
01600	R←R+1;  OUTSTR(CVS(FVAL[4] LSH -15)&TB); IF (R MOD 10)=9 THEN OUTSTR(CRLF);
01610	
01620	FORM(1);
01625	FFTOUT;
01630	 PREPARE;
01640	
01650	JP←JP-1; READ1←INCHRS;
01660	IF (READ1="F")∨(READ1="f") THEN BEGIN CLRBUF; READ1←"";
01670	  JP←-10; OUTSTR(CRLF&LF&"Will stop at the end of this file"&CRLF&LF); END;
01680	IF (READ1="E")∨(READ1="e") then goto stopp;
01690	 IF (READ1=" ")∨(JP=0)∨(FVAL[0]=FVAL[1])  THEN  BEGIN "SHOW"
01700	TYPLOC(512,170); DPYSET(DPYBUF);
01710	JP←FVAL[0]←10000;
01720	OUTSTR(CRLF&"File "&FILEN&CRLF);
01730	  OUTSTR(CRLF&"Data for interval from "&CVS(FVAL[4] LSH -15)
01740	    &" to "&CVS(FVAL[5] LSH -15));
01750	  FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
01760	IF JPX>(FVAL[5] LSH -15) THEN OUTSTR(" is undesignated."&crlf)
01770	  else BEGIN
01780	  OUTSTR(" is designated as the phone "&CVSTR(L));OUTSTR(CRLF);
01790	  IF Q<127 THEN OUTSTR(TB&" as in "&SAMPLE[Q]&CRLF); END;
01800	
01810	FOR I←0 STEP 1 UNTIL 9 DO OUTALL(CVSTR(INNAME[I])&TB); OUTSTR(CRLF);
01820	FOR I←0 STEP 1 UNTIL 9 DO OUTALL(CVS(INDATA[I])&TB); OUTSTR(CRLF&LF);
01830	FOR I←10 STEP 1 UNTIL 14 DO OUTALL(CVSTR(INNAME[I])&TB); OUTSTR(CRLF);
01840	FOR I←10 STEP 1 UNTIL 14 DO OUTSTR(CVS(INDATA[I])&TB);   OUTSTR(CRLF);
01850	AIVECT(-599,0);MARK;
01860	AIVECT(-599,-340); RARDIS;
01870	DPYOUT(0);PTOCHW(0,'10120);
01880	⊂   OUTSTR("Type P for XGP copy file or type next command.");
01890	  OUTSTR("Space to run, LF for next, # for sample #, +# to add periods."&CRLF);
01900	⊂ FOR QQ←4 STEP 1 UNTIL 4095 DO IF DPYBUF[QQ] =1 THEN DONE;
01910	⊂ OUTSTR("DPYBUF filled to "&CVS(QQ)&CRLF);
01920	
01930	READ1←INCHRW;
01940	WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
01950	  PTOCHW(0,'10120);READ1←INCHRW; END;
01960	IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
01970	  OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP.  Next command please."&CRLF);
01980	  READ1←INCHRW;   END;
01990	K←CVASC(READ1); OPT1←0;
02000	
02010	IF K=CVASC("+") THEN BEGIN
02020	  JP←CVD(INCHWL); FVAL[0]←10000; END;
02030	IF K≥CVASC("0") THEN IF K≤CVASC("9") THEN BEGIN
02040	  FVAL[0]←INCHWL; JP←10000; END;
02050	  OUTSTR(CR);
02060	  IF READ1=" " THEN FVAL[0]←JP←10000;
02070	  IF(READ1="F")∨(READ1="f") THEN JP←-1;
02080	  IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02090	
02100	IF (READ1='15)∨(READ1='12) THEN BEGIN JP←1; CLRBUF; END;
02110	
02120	TOFORM:
02130	  IF (READ1="S")∨(READ1="s") THEN JP←JP+1;
02140	  IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02150	PTOCHW(0,'10103); CLRBUF;  TYPLOC(512,-170); PTOCHW(0,'10120);
02160	END "SHOW";
02170	
02180	
02190	END "GET";
02200	CLOSE(CHAN1); CLOSE(CHAN3);
02210	DATOUT;
02220	FFTX←512; FFTOUT;
02230	 IF JP<0 THEN DONE;
02240	END "FILEREAD";
02250	
02260	OUTSTR("Data are exhausted"&CRLF&LF);
02270	STOPP: PTOCHW(0,'10103); PTOCHW(0,'10120);
02280	CLOSE(CHAN1);CLOSE(CHAN2);CLOSE(CHAN3);
02285	CLOSE(CHAN4);CLOSE(CHAN5);CLOSE(CHAN6);
02290	
02300	END "FIX";
02310